home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro6.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-02  |  6.2 KB  |  215 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 6
  27. }
  28. PROGRAM TED_INTRO_NR6;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33.  SIZE           = 10955; { SIZE OF ORYGINAL FONT FILE, NOT .OBJ BUT .TED!!! }
  34. VAR
  35.  BITMAP         : ARRAY [1..30,0..319] OF BYTE;
  36.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  37.  CHARS          : ARRAY [' '..']'] OF POINTER;
  38.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  39.  F              : FILE;
  40.  B,ROW,NR       : BYTE;
  41.  X,Y,I,J        : INTEGER;
  42.  CH,K           : CHAR;
  43.  TEKST          : STRING;
  44.  SINUS          : ARRAY [0..255] OF BYTE;
  45.  SINN           : BYTE;
  46.  
  47. {───────────────────────────────────────────────────────────────────────────}
  48. {$F+}
  49. {$L FONT001F.OBJ}
  50. PROCEDURE FDATA; EXTERNAL; { .TED FILE - FONT DATA }
  51. {$L FONT001P.OBJ}
  52. PROCEDURE PDATA; EXTERNAL; { .PAL FILE - PALETTE DATA }
  53. {$F-}
  54. {───────────────────────────────────────────────────────────────────────────}
  55. PROCEDURE CALCSIN;
  56. VAR I : INTEGER;
  57. BEGIN
  58.  FOR I := 0 TO 255 DO SINUS[I] := ROUND(SIN(15*I*PI/755)*24)+70;
  59. END;
  60. {───────────────────────────────────────────────────────────────────────────}
  61. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  62. ASM
  63.  MOV AX,0013H
  64.  INT 10H
  65. END;
  66. {───────────────────────────────────────────────────────────────────────────}
  67. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  68. ASM
  69.  MOV AX,0003H
  70.  INT 10H
  71. END;
  72. {───────────────────────────────────────────────────────────────────────────}
  73. PROCEDURE VSYNC; ASSEMBLER;
  74. ASM
  75.  MOV DX,03DAH
  76.  @@1: IN AL,DX; TEST AL,8; JNZ @@1;
  77.  @@2: IN AL,DX; TEST AL,8; JZ  @@2;
  78. END;
  79. {───────────────────────────────────────────────────────────────────────────}
  80. PROCEDURE DRAWBITMAP(OFSiI: WORD); ASSEMBLER;
  81. ASM
  82.  MOV DI,OFSiI
  83.  MOV ES,SEGA000
  84.  MOV SI,OFFSET BITMAP
  85.  MOV CX,4800
  86.  CLD
  87.  REP MOVSW
  88. END;
  89. {───────────────────────────────────────────────────────────────────────────}
  90. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  91. ASM
  92.   LDS SI,MAP
  93.   LES DI,MAP
  94.   INC SI
  95.   INC SI
  96.   MOV CX,4800
  97.   REP MOVSW
  98. END;
  99. {───────────────────────────────────────────────────────────────────────────}
  100. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  101. ASM
  102.  MOV DX,3C8H
  103.  MOV AL,NR
  104.  OUT DX,AL
  105.  INC DX
  106.  MOV AL,R
  107.  OUT DX,AL
  108.  MOV AL,G
  109.  OUT DX,AL
  110.  MOV AL,B
  111.  OUT DX,AL
  112. END;
  113. {───────────────────────────────────────────────────────────────────────────}
  114. PROCEDURE LOADPAL; { LOAD .PAL FILE AND SET PALETTE }
  115. BEGIN
  116.  MOVE(MEM[SEG(PDATA):OFS(PDATA)],PALETTE,768);
  117.  FOR B:=0 TO 255 DO
  118.   SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  119.  SETCOLOR(0,11,1,11);
  120. END;
  121. {───────────────────────────────────────────────────────────────────────────}
  122. PROCEDURE LOADTED; { LOAD .TED FILE TO MEMORY }
  123. VAR TX,TY: BYTE; CH: CHAR;
  124.     SEGM,OFST,EOFS: WORD;
  125. BEGIN
  126.  SEGM:=SEG(FDATA);
  127.  OFST:=OFS(FDATA);
  128.  EOFS:=OFST+SIZE;
  129.  INC(OFST,20); { SKIP FILE HEADER }
  130.  WHILE NOT(OFST=EOFS) DO
  131.  BEGIN
  132.   MOVE(MEM[SEGM:OFST],CH,1); INC(OFST);
  133.   MOVE(MEM[SEGM:OFST],TX,1); INC(OFST);
  134.   MOVE(MEM[SEGM:OFST],TY,1); INC(OFST);
  135.   GETMEM(CHARS[CH],TX*TY);
  136.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  137.   MOVE(MEM[SEGM:OFST],CHARS[CH]^,TX*TY); INC(OFST,TX*TY);
  138.  END;
  139.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  140.  BEGIN
  141.   TX:=CHARSDATA['A',1];
  142.   TY:=CHARSDATA['A',2];
  143.   GETMEM(CHARS[' '],TX*TY);
  144.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  145.   CHARSDATA[' ',3]:=1;
  146.   CHARSDATA[' ',1]:=TX;
  147.   CHARSDATA[' ',2]:=TY;
  148.  END;
  149. END;
  150. {───────────────────────────────────────────────────────────────────────────}
  151. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  152. VAR CH: CHAR;
  153. BEGIN
  154.  FOR CH:=' ' TO ']' DO
  155.  BEGIN
  156.   IF CHARSDATA[CH,3]=1 THEN
  157.   BEGIN
  158.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  159.    CHARSDATA[CH,3]:=0;
  160.   END;
  161.  END;
  162. END;
  163. {───────────────────────────────────────────────────────────────────────────}
  164. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  165. VAR TX,TY,IC: INTEGER;
  166. BEGIN
  167.  IF CHARSDATA[CH,3]<>1 THEN EXIT; { EXIT IF NO CHAR IN FONT }
  168.  IC:=7;
  169.  FOR TY:=1 TO 30 DO BITMAP[TY,POS]:=0;
  170.  IF RO=CHARSDATA[CH,1]+1 THEN
  171.   FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[TY+IC,POS]:=0 { SKIP ONE ROW }
  172.  ELSE
  173.   FOR TY:=1 TO CHARSDATA[CH,2] DO
  174.    BITMAP[TY+IC,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  175. END;
  176. {───────────────────────────────────────────────────────────────────────────}
  177. PROCEDURE UPDATE; { NEW VALUES ? }
  178. BEGIN
  179.  INC(ROW);
  180.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  181.  BEGIN
  182.   ROW:=1;
  183.   INC(NR);
  184.   IF NR>LENGTH(TEKST) THEN NR:=1;
  185.  END;
  186. END;
  187. {───────────────────────────────────────────────────────────────────────────}
  188.  
  189.  
  190.  
  191. BEGIN
  192.  CALCSIN;
  193.  INITVGA;
  194.  LOADPAL;
  195.  LOADTED;
  196.  ROW:=1;
  197.  TEKST:=' OK DUDE! THERE IS A SMALL EXAMPLE HOW TO LINK .PAL AND .TED '+
  198.         ' FILES INTO ONE EXE! I LIKE THIS FONT... BECUZ ITS SMALL AND PRETTY :] '+
  199.         '  U CAN USE PKLITE OR LZEXE TO SMALL IT!!! .............               ';
  200.  NR:=1;
  201.  SINN:=0;
  202.  FILLCHAR(BITMAP,SIZEOF(BITMAP),0);
  203.  REPEAT
  204.   SCROLLBITMAP(BITMAP);
  205.   UPDATE;
  206.   NEWROW(TEKST[NR],ROW,318);
  207.   UPDATE;
  208.   NEWROW(TEKST[NR],ROW,319);
  209.   DRAWBITMAP(SINUS[SINN]*320);
  210.   VSYNC;
  211.   INC(SINN); IF SINN=101 THEN SINN:=0;
  212.  UNTIL KEYPRESSED;
  213.  DONETED;
  214.  CLOSEVGA;
  215. END.